home *** CD-ROM | disk | FTP | other *** search
/ MacWorld: Complete Mac Interactive / Macworld Complete Mac Interactive CD)(1994).iso / The Best of BMUG / Utilities / Text and Speech / Alpha.5.76 / Tcl / SystemCode / think.tcl < prev    next >
Encoding:
Text File  |  1994-03-08  |  7.2 KB  |  324 lines  |  [TEXT/ALFA]
  1.  
  2. # The commands so far are:
  3. #     "thinkFileName <index>|<name>"             - Indexes start at '1'.
  4.  
  5. set THINK "THINK Project Manager"
  6. set ALPHA "Alpha 5.72i"
  7.  
  8. # The following flags affect the "Run" command.
  9. set runWithDebugger        1
  10. set runWithGo             1
  11. # 'ask ', 'yes ', or 'no  '
  12. set runWithUpdate         "'yes '"
  13. set    runWithSaveDirty    "'yes '"
  14.  
  15.  
  16. proc thinkNumFiles {} {
  17.     global THINK
  18.     set str [AEBuild -r $THINK "core" "cnte" "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}} "kocl" "type('SFIL')"]
  19.     if {[regexp {[0-9]+} $str mtch]} {
  20.         return $mtch
  21.     } else {
  22.         error "Bad numfiles"
  23.     }
  24. }
  25.  
  26.  
  27.  
  28. # Get list of files in current project.
  29. proc projectFileList args {
  30.     watchCursor
  31.     set num [thinkNumFiles]
  32.     set files {}
  33.     if {[llength $args]} {
  34.         for {set i 1} {$i<=$num} {incr i} {
  35.             lappend files [thinkFileName -p $i]
  36.         }
  37.     } else {
  38.         for {set i 1} {$i<=$num} {incr i} {
  39.             lappend files [thinkFileName $i]
  40.         }
  41.     }
  42.     return $files
  43. }
  44.  
  45.  
  46.  
  47. # Think reference 2.0 support. From the shell:
  48. #    dosc -c 'DanR' -k 'DanR' -e "'REF '" -s "PutScrap"
  49. # tells think reference to find and display the correct reference.
  50. #    dosc -c 'DanR' -k 'DanR' -e 'TMPL' -s "PutScrap"
  51. # queries Think Reference for a function template and IM reference,
  52. # and displays information about the function in the background.
  53. # The following function interprets the selected text as a function 
  54. # name and displays in an alert the function template.
  55. proc thinkReferenceTemplate args {
  56.     if {[getPos] == [selEnd]} return
  57.     catch {dosc -c 'DanR' -k 'DanR' -e 'TMPL' -s [getSelect]} res
  58.     alertnote $res
  59. }
  60.  
  61.  
  62.  
  63. #================================================================================
  64. set lastTrap {}
  65.  
  66. proc insertTrapTemplate {} {
  67.     global lastTrap
  68.  
  69.     if {![string length [checkRunning ThinkReference DanR referencePath]]} return
  70.     set text [getSelect]
  71.     if {![string length $text]} {
  72.         if {[catch {prompt "Trap name:" $lastTrap} text]} return
  73.     } else {
  74.         deleteText [getPos] [selEnd]
  75.     }
  76.     set lastTrap $text
  77.     if {[catch {thinkReference -t $text} out]} {
  78.         alertnote "THINK Reference not running..."
  79.     } else {
  80.         insertText $out
  81.     }
  82. }
  83.  
  84. proc displayTrapTemplate {} {
  85.     global lastTrap
  86.  
  87.     if {![string length [checkRunning ThinkReference DanR referencePath]]} return
  88.     set text {}
  89.     catch {set text [getSelect]}
  90.     if {![string length $text]} {
  91.         if {[catch {prompt "Trap name:" $lastTrap} text]} return
  92.     }
  93.     set lastTrap $text
  94.     if {[catch {thinkReference -t $text} out]} {
  95.         alertnote "THINK Reference not running..."
  96.     } else {
  97.         alertnote $out
  98.     }
  99. }
  100.  
  101. proc lookupTrap {} {
  102.     global lastTrap
  103.  
  104.     if {![string length [checkRunning ThinkReference DanR referencePath]]} return
  105.     set text {}
  106.     catch {set text [getSelect]}
  107.     if {![string length $text]} {
  108.         if {[catch {prompt "Trap name:" $lastTrap} text]} return
  109.     }
  110.     set lastTrap $text
  111.     if {[catch {thinkReference -l aesend $text}]} {
  112.         alertnote "THINK Reference not running..."
  113.     }
  114. }
  115.  
  116. proc gotoReference {} {
  117.     catch {switchTo [checkRunning ThinkReference DanR referencePath]}
  118. }
  119.  
  120.  
  121. #================================================================================
  122.  
  123.  
  124. proc think {} {
  125.     set name [checkRunning ThinkC KAHL thinkName]
  126.     if {![string length $name]} return
  127.     switchTo $name
  128. }
  129.  
  130. proc searchNextFile {} {
  131.     thinkFinf
  132. }
  133.  
  134.  
  135. # The 'Files' menu can instantiate itself from the THINK Project Manager if 
  136. # it is running. 
  137. menu -n $thinkMenu {
  138.     "/-think"
  139.     "openHeader"
  140.     "setIncludepath…"
  141.     {menu -n thinkRef {
  142.         "gotoReference"
  143.         "(-"
  144.         "displayTrapTemplate"
  145.         "insertTrapTemplate"
  146.         "lookupTrap"
  147.     }}
  148.     "(-"
  149.     {menu -n {Project Files} {
  150.         "getProjectFiles"}}
  151.     "createProjectFileset"
  152.     "(-"
  153.     "/Kcompile"
  154.     "checkSyntax"
  155.     "searchNextFile"
  156.     "(-"
  157.     "add"
  158.     "addAndCompile"
  159.     "(-"
  160.     "disassemble"
  161.     "preprocess"
  162.     "(precompile"
  163.     "(-"
  164.     "/UbringUpToDate"
  165.     "make"
  166.     "(-"
  167.     "/Rrun"
  168. }
  169. makeFilesetMenu
  170.  
  171. proc getProjectFiles args {
  172.     menu -n {Project Files} -m -p projFile [lsort [projectFileList -p]]
  173. }
  174.  
  175. proc projFile {menu name} {
  176.     edit [thinkFileName $name]
  177. }
  178.  
  179.  
  180. #===========================================================================
  181. # Add fileset.
  182. #===========================================================================
  183. proc createProjectFileset {} {
  184.     global fileSets
  185.     global currFileSet
  186.     
  187.     set name "Project"
  188.     set fileSets($name) [projectFileList]
  189.     addMenuItem -m choose $name
  190.     set currFileSet $name
  191. }
  192.  
  193. #================================================================================
  194.  
  195. proc checkIncludepath {} {
  196.     global includePath
  197.     set bad 0
  198.     if {![info exists includePath]} {return [setIncludepath]}
  199.     foreach p [subVars $includePath] {
  200.         if {![file exists $p]} {set bad 1}
  201.     }
  202.     if ($bad) setIncludepath
  203. }
  204.  
  205. proc setIncludepath {} {
  206.     global includePath HOME
  207.     
  208.     set includePath {}
  209.     
  210.     while {![catch {set path [get_directory]}]} {
  211.         lappend includePath $path
  212.     }
  213.     
  214.     set fid [open "$HOME:Tcl:SystemCode:definitions.tcl" "a"]
  215.     puts $fid "set includePath \"$includePath\""
  216.     close $fid
  217. }
  218.  
  219. proc openHeader {} {
  220.     global includePath
  221.  
  222.     checkIncludepath
  223.     set path [subVars $includePath]
  224.     set fname [getSelect]
  225.     if {[string last ".h" $fname]=="-1"} {
  226.         set fname ${fname}.h
  227.     }
  228.     set win [lindex [winNames -f] 0]
  229.     if {[string match *:* $win]} {
  230.         lappend path [file dirname $win]
  231.     }
  232.     foreach dir $path {
  233.         if {[file exists $dir:$fname]} {
  234.             edit $dir:$fname
  235.             return
  236.         }
  237.     }
  238.     beep
  239.     message "No such header file"
  240. }
  241.  
  242. #================================================================================
  243.  
  244. proc sendOpenEvent {filler appname fname} {
  245.     AEBuild $appname aevt odoc "----" [concat {[alis(«} [coerce TEXT $fname -x alis] {»)]}]
  246. }
  247.  
  248. proc compile {} {
  249.     sendCompileEvent CMPL
  250. }
  251.  
  252. proc checkSyntax {} {
  253.     sendCompileEvent SNTX
  254. }
  255.  
  256. proc disassemble {} {
  257.     sendCompileEvent DASM
  258. }
  259.  
  260. proc preprocess {} {
  261.     "Think isn't quite there yet..."
  262.     return
  263. }
  264.  
  265. proc sendCompileEvent {event} {
  266.     global THINK ALPHA
  267.     set name [lindex [winNames -f] 0]
  268.     switchTo $THINK
  269.     set res [AEBuild -r -t 6000 $THINK KAHL $event "----" [join [concat {obj\{want:type('SFIL'), from:'null'(), form:'name', seld:“} [file tail $name] {”\}}] ""]]
  270.     switchTo $ALPHA
  271.     return $res
  272. }
  273.  
  274.  
  275. proc add {} {
  276.     global THINK
  277.     set fname [lindex [winNames -f] 0]
  278.     AEBuild $THINK core crel "data" [concat {[alis(«} [coerce TEXT $fname -x alis] {»)]}] "kocl" "type('SFIL')"
  279. }
  280.  
  281. proc addAndCompile {} {
  282.     add
  283.     compile
  284. }
  285.  
  286.  
  287. proc precompile {} {
  288.     alertnote "Someday…"
  289. }
  290.  
  291. proc bringUpToDate {} {
  292.     alertnote "Someday…"
  293. }
  294.  
  295. proc make {} {
  296.     global THINK ALPHA
  297.     switchTo $THINK
  298.     set res [AEBuild -r -t 6000 $THINK KAHL MAKE "CFLG" "long(«02»)" "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}}] 
  299.     switchTo $ALPHA
  300.     return $res
  301. }
  302.  
  303. proc run {} {
  304.     global runWithDebugger runWithGo runWithUpdate runWithSaveDirty THINK
  305.     set dbug [expr {$runWithDebugger ? "bool(«01»)" : "bool(«00»)"}]
  306.     set go [expr {$runWithGo ? "bool(«01»)" : "bool(«00»)"}]
  307.     switchTo $THINK
  308.     AEBuild -t 6000 -r $THINK KAHL "RUN " "DBUG" $dbug  "GO  " $go "UPDT" $runWithUpdate "savo" $runWithSaveDirty
  309. }
  310.  
  311. proc cnt {} {
  312.     global THINK
  313.     AEBuild -t 6000 -r $THINK core cnte "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}} "kocl" "type('sfil')"
  314. }
  315.  
  316. proc thinkFileName {arg} {
  317.     global THINK
  318.     set event [join [concat {obj\ \{want:type('prop'),\ from:obj\ \{want:type('SFIL'),\ from:'null'(),\ form:'indx',\ seld:} $arg {\},\ form:'prop',\ seld:type('FSS\ ')\}}] ""]
  319.     set blah [AEBuild -r $THINK "core" "getd"  "----" $event]
  320.     regexp {«[0-9A-F]+»} $blah mtch
  321.     return [string trim $mtch "«»"]
  322. }
  323.  
  324.